COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "VMAP"
C00004 00003	INTEGER TRUNCATE,ATTENUATE,NEGATE,CONTOUR
C00006 ENDMK
C⊗;
BEGIN "VMAP"

REQUIRE "PROLOG.HDR[1,PDQ]" SOURCE_FILE;
REQUIRE "TTYSUB.HDR[1,PDQ]" SOURCE_FILE;

INTEGER CHN,EOF,I;
DEFINE N=63;
DEFINE MASK='377, OBPS=8,IBPS=6;

INTEGER_ARRAY TABL[0:N];

REAL GAMMA;

DEFINE MAPADR='771000;

INTEGER PROCEDURE GAMFN(INTEGER I);
BEGIN	INTEGER M;
	M←1 LSH OBPS;
	RETURN(M*(I/M)↑GAMMA);
END;

PROCEDURE MAPSET(INTEGER_ARRAY TABL);
BEGIN
INTEGER WD;
WD←1 LSH 35 + 1 LSH 17 + MAPADR LSH -1;
USETO(CHN,LOCATION(WD));
USETI(CHN,LOCATION(WD));
ARRYOUT(CHN,TABL[0],N+1);
END;



PROCEDURE HACK(INTEGER_ARRAY TABL);

 WHILE INCHRS<0 DO
	BEGIN	INTEGER V,I;
		V←TABL[0];
		FOR I←0 STEP 1 UNTIL N-1 DO
		 TABL[I]←TABL[I+1];
		TABL[N]←V;
		MAPSET(TABL);
	END;

INTEGER TRUNCATE,ATTENUATE,NEGATE,CONTOUR;

OPEN(CHN←GETCHAN,"ELF",'17,0,0,0,0,EOF);
GAMMA←1;
CONTOUR←ATTENUATE←TRUNCATE←0;
NEGATE←FALSE;

WHILE TRUE DO
BEGIN
STRING STR;
INTEGER C;
REAL X;

STR←STRIN("←");
C←LOP(STR);
X←REALSCAN(STR,0);
CASE C OF
  BEGIN	["G"] GAMMA←X;
	["←"] CONTOUR←X;
	["→"] ATTENUATE←X;
	["T"] TRUNCATE←X;
	["H"] HACK(TABL);
	["-"] NEGATE←NOT(NEGATE)
  END;

FOR I←0 STEP 1 UNTIL N DO
 BEGIN
	INTEGER V;
	V←I LSH (OBPS-IBPS);
	V←((V LSH CONTOUR) LAND MASK) LOR (V LSH (CONTOUR-OBPS));
	V←GAMFN(V);
	V←V LSH -ATTENUATE;
	V←V LAND (-1 LSH TRUNCATE);
	IF NEGATE THEN V←V XOR MASK;
	TABL[I]←V;
 END;

MAPSET(TABL);
END;


RELEASE(CHN);

END;